Multimedia Selection/Multimedia Selection Volume One - CD-ROM/MULTIMEDIA SELECTION____________.ISO/utils/gnomes1/gnomes.pas

Pascal/Delphi Source File | 1993-09-09 | 5.8 KB | 228 lines

PROGRAM ShowRandomOneLiners;
{------------------------------------------------------------------------------

                                REVISION HISTORY

v1.00  : 1993/07/14.  First public release.  DDA
v1.00a : 1993/08/30.  Fixed cursoron procedure, with thanks to David Cheung.
                      Increased allowable length of filename from 12 to 48
                      characters.  DDA
v1.01  : 1993/09/10.  New getcursor and setcursor procedures, via Randall
                          Woodman.  Supercede cursoroff/ cursoron.     DDA

------------------------------------------------------------------------------}

USES Dos, Crt;
CONST
   ProgData = 'GNOMES- Free DOS utility: Tagline displayer.';
   ProgDat2 = 'V1.01: September 10, 1993. (c) 1993 by David Daniel Anderson - Reign Ware.';

   Usage1 = 'Usage:  GNOMES [/s (simple)] [file to randomly display]';
   Usage2 = '     See gnomes.doc for more details.';
VAR
   OneLinerFile  : Text;
   TheOneLiner   : String;
   TotalLines    : LongInt;
   Simple        : Boolean;
   ctop, cbot    : integer ;

{ These two cursor procedures are via Randall Woodman }

procedure getcursor (var chval, clval : integer );
const
   video  = $0010;
   getcur = $0300;
var
  regs : registers ;
begin
   regs.ax := getcur ;
   intr(video,regs) ;
   chval := regs.ch;  { upper scan line }
   clval := regs.cl;  { lower scan line }
end;

procedure setcursor ( startscan, stopscan : integer );
const
  videoio     = $10;
  cursorshape =   1;
var
  regs : registers ;
begin
  with regs do
    begin
      ch:=startscan;
      cl:=stopscan;
      ah:=cursorshape;
      intr(videoio,regs);
    end;
end;

PROCEDURE InitializeAll;
VAR
   OLFName       : String[48];
   PS1           : String[2];
   strtline  : string[6];
   valtline  : longint;
   valcode   : integer;
BEGIN

     PS1 := Copy(ParamStr(1),1,2);
     IF PS1 = '/s' THEN
     BEGIN
        WriteLn;
        Simple := True;
        OLFName := ParamStr(2);
     END
     ELSE BEGIN
        Simple := False;
        OLFName := ParamStr(1);
     END;

     IF OLFName = '' THEN
        OLFName := 'GNOMES.TXT';

     Assign(OneLinerFile,OLFName);
{$I-} Reset(OneLinerFile); {$I+}
     IF IOResult <> 0 THEN
     BEGIN
        NormVideo;
        Writeln(ProgData);
        Writeln(ProgDat2);
        Writeln;
        WriteLn(Usage1);
        WriteLn;
        WriteLn(Usage2);
        WriteLn('Unable to open ',OLFName,'.');
        Halt;
     END;
     ReadLn(OneLinerFile,strtline);
     strtline := copy(strtline,1,Length(strtline));
     val(strtline,valtline,valcode);
     if (valcode <> 0) then begin
        NormVideo;
        Writeln(ProgData);
        Writeln(ProgDat2);
        Writeln;
        WriteLn(Usage1);
        WriteLn;
        WriteLn(Usage2);
        writeln('The first line of the file "',OLFName,'" is NOT a valid numeric!');
        writeln('Program aborted.');
        halt;
     end;
     TotalLines := valtline;

     getcursor ( ctop, cbot );
     setcursor ( 0, 0 );
     TextAttr := 8;
END;

FUNCTION LeadingZero(w : Word) : String;  {Called by WriteDTInf to write time.}
VAR
  s : String;
BEGIN
  Str(w:0,s);
  IF Length(s) = 1 THEN
    s := '0' + s;
  LeadingZero := s;
END;

PROCEDURE WriteDTInf;      {Called by DisplayOneLiner to write Date & Time.}
VAR
   Hour,Min,Sec, hund    : Word;
   i : Integer;
BEGIN
     GetTime(Hour,Min,Sec,hund);
     FOR i := 1 to 53 DO
         Write(' ');

     Write('System time is:  ');
     WriteLn(LeadingZero(Hour),':',
             LeadingZero(Min),':',
             LeadingZero(Sec));
     FOR i := 1 to 80 DO
         Write('_');
     WriteLn;
END;

PROCEDURE WrapOneLiner(var theline : string);
VAR
   PartA,PartB  : String;
   BreakChar    : String[1];
BEGIN
     PartA := Copy(theline,1,80);
     PartB := Copy(theline,81,(Length(theline)-80));
     BreakChar := Copy(PartA,Length(PartA),1);
     Delete(PartA,Length(PartA),1);

     if (breakchar = '-') then begin
          partb := breakchar + partb;
          breakchar := copy(parta,length(parta),1);
          delete(parta,length(parta),1);
     end;
     while ((breakchar <> ' ')
        and (breakchar <> '-')) do
     begin
          partb := breakchar + partb;
          breakchar := copy(parta,length(parta),1);
          delete(parta,length(parta),1);
     end;
     if (breakchar = '-') then
        parta := parta + breakchar;

     writeln(parta);
     theline := PartB;
END;

PROCEDURE DisplayOneLiner;
VAR
   i,
   OneLinerNumb  : Integer;
   DumDum        : Char;    {To trap the key(s) pressed to terminate program.}
BEGIN
     TextAttr := Succ(TextAttr);
     IF ((TextAttr = 15) AND (NOT Simple)) THEN
     BEGIN
        WriteDTInf;
        TextAttr := 9;
     END;
     Reset(OneLinerFile);
     Randomize;
     OneLinerNumb := (Random(TotalLines) + 2);  {To account for 0 and first.}
     FOR i := 1 to OneLinerNumb DO        {   }{───────────┬─────────────}
         ReadLn(OneLinerFile,TheOneLiner);{└─────────────────┘              }
     WHILE Length(TheOneLiner) >= 80 DO
           WrapOneLiner(TheOneLiner);
     WriteLn(TheOneLiner);
     IF (NOT Simple) THEN
     BEGIN
         FOR i := 1 to 80 DO
             Write('_');
         WriteLn;
         FOR i := 1 to 50 DO
             IF (NOT KeyPressed) THEN
                Delay(95);
     END;
     IF KeyPressed THEN
     BEGIN
        Simple := True;
        WHILE KeyPressed DO
              DumDum := ReadKey;
     END;
END;

PROCEDURE CleanUp;
BEGIN
     Close (OneLinerFile);
     setcursor ( ctop, cbot );
     NormVideo;
END;

BEGIN
     InitializeAll;
     REPEAT
           DisplayOneLiner;
     UNTIL Simple;
     CleanUp;
END.